home *** CD-ROM | disk | FTP | other *** search
Text File | 1996-05-21 | 15.5 KB | 546 lines | [TEXT/ttxt] |
- ---<<<
- in module Autofinder
-
- class AutoFinderTitle (TitleContainer)
- instance variables
- dir -- The directory of containers.
- media
- mouse -- MouseDevice to change cursor to @Wait and @Arrow.
- stage -- The main full screen window of the title.
- currentscene -- The current scene in the stage
- music -- Music for intro
- -- intro
- queryCriteria -- Selections made by user
- carDatabase -- The database of classified ads for available cars.
- modelDatabase -- The database of model cars.
- carsChosen -- The result of searching database with queryCriteria.
- modelsChosen -- The model cars which represent the intro query.
- buttons -- list of currently visible buttons
- grapherButton
- mapButton
- classifiedsButton
- mainMenuButton
- exitButton
- actuator
- end
-
- method afterinit self {class AutoFinderTitle} #rest args ->
- (
- local media
-
- apply nextMethod self args
-
- self.mouse := new MouseDevice
- self.buttons := #()
- self.queryCriteria := new KeyedLinkedList
- self.currentScene := undefined
-
- media := open librarycontainer dir:(parentDir theScriptDir) \
- path:"media.sxl"
-
-
- local MainMenuButton := new navigationButton name:"MainMenu" \
- releasedBitmap:media["Main Hilite"].bbox \
- pressedBitmap:media["Main Hilite"]
- MainMenuButton.authordata := self
- MainMenuButton.activateAction := (adata pb ->
- addTimeCallback theEventTimeStampClock (autofind -> enterMainMenu autoFind) \
- adata #() theEventTimeStampClock.time true
- )
- self.mainMenuButton := mainMenuButton
-
- local MapButton := new navigationButton name:"Map" \
- releasedBitmap:media["Map Hilite"].bbox \
- pressedBitmap:media["Map Hilite"]
- MapButton.authordata := self
- MapButton.activateAction := (adata pb ->
- if (getClass adata.currentScene = AutofinderMenu) do
- (
- local query := getQueryCriteria adata.currentScene
- executeQuery adata query
- adata.queryCriteria := query
- )
- addTimeCallback theEventTimeStampClock (autofind -> enterMap autoFind) \
- adata #() theEventTimeStampClock.time true
- )
- self.mapButton := MapButton
-
- local GrapherButton := new navigationButton name:"Grapher" \
- releasedBitmap:media["Graph Hilite"].bbox \
- pressedBitmap:media["Graph Hilite"]
- GrapherButton.authordata := self
- GrapherButton.activateAction := (adata pb ->
- if (getClass adata.currentScene = AutofinderMenu) do
- (
- local query := getQueryCriteria adata.currentScene
- executeQuery adata query
- adata.queryCriteria := query
- )
- addTimeCallback theEventTimeStampClock (autofind -> enterGrapher autoFind) \
- adata #() theEventTimeStampClock.time true
- )
- self.grapherButton := grapherButton
-
- local ClassifiedButton := new navigationButton name:"Classified" \
- releasedBitmap:media["Class Hilite"].bbox \
- pressedBitmap:media["Class Hilite"]
- ClassifiedButton.authordata := self
- ClassifiedButton.activateAction := (adata pb ->
- if (getClass adata.currentScene = AutofinderMenu) do
- (
- local query := getQueryCriteria adata.currentScene
- executeQuery adata query
- adata.queryCriteria := query
- )
- addTimeCallback theEventTimeStampClock (autofind -> enterAds autoFind) \
- adata #() theEventTimeStampClock.time true
- )
- self.classifiedsButton := classifiedButton
-
- self.media := media
-
- self
- )
-
- -- Method createStage hides the system menu bar, and creates the main window.
- method createStage self {class AutoFinderTitle} ->
- (
- local mouse := self.mouse
- mouse.pointerType := @Wait
-
- hide self.systemMenuBar
- self.stage := new FullScreenWindow \
- title:self fill:blackBrush \
- boundary:(new rect x2:640 y2:480) \
- centered:true \
- borderFill:blackbrush
- self.stage.clock.scale := 24
-
- -- If running from title container, use title container directory, else, parentDir.
- if (self.directory <> undefined) then
- self.dir := self.directory
- else
- self.dir := parentDir theScriptDir
-
- self.actuator := new ActuatorController space:self.stage wholeSpace:false
-
- show self.stage
- self.mouse.pointerType := @Arrow
- )
-
- -- Method changeScene removes the current scene from the stage, and adds the new scene.
- method changeScene self {class AutoFinderTitle} newScene ->
- (
- endMusic self
-
- -- If the currentScene is the grapher, modify cars and models selected
- if (getclass self.currentScene = AutoGrapher) do
- (
- local modelsSelected := self.currentScene.objectList
- local modelList := for c in modelsSelected collect c.name
- local function carMatch car dummy -> (isAKindOf car adDataObject) and \
- (isMember modelList car.model)
- local carsSelected := chooseAll self.carsChosen carMatch undefined
- self.modelsChosen := modelsSelected
- self.carsChosen := carsSelected
- )
-
- -- If the currentScene is the map, besure to close detail map window
- if (getclass self.currentScene = Mapper) do
- (
- local map := self.currentscene
- local detailDoc := map.detailDocument
- if (NOT detailDoc == undefined) do
- (
- local detailWin := detailDoc.presentedBy
- if detailWin.isVisible do hide detailWin
- )
- )
-
- self.stage.compositor.enabled := false
- -- Delete the current scene and make it purgeable.
- if (self.currentScene <> undefined) do
- (
- -- Remove buttons from stage
- emptyout self.actuator
- for butn in self.buttons do deleteOne self.stage butn
- emptyout self.buttons
-
- deleteOne self.stage self.currentScene
- leaveScene self.currentScene
- -- if (canObjectDo self.currentScene purgeObject) do
- -- purgeObject self.currentScene
- self.currentScene := undefined
- )
-
- -- Change to the new scene.
- self.currentScene := newScene
- prepend self.stage self.currentScene
- self.stage.compositor.enabled := true
- )
-
- -- Method start inits scenes, and plays the introduction.
- method start self {class AutoFinderTitle} ->
- (
- -- should get moved to an init
- initKeyboardWatch self
-
- -- Create carDB from carAd data
- local carDB := new Array
- local adLib := open LibraryContainer dir:self.dir path:"cars.sxl" \
- mode:@readOnly
- for i in adLib[@data] do
- (
- local ad := new AdDataObject data:i
- append carDB ad
- )
-
- self.carDatabase := carDB
-
- -- Create modelDB from modelCar data
- local modelDB := #()
- local modelLib := open LibraryContainer dir:self.dir path:"models.sxl" \
- mode:@readonly
- for model in (modelLib[@data]) do
- (
- local objProperties := model[2]
- local obj := apply makeModelCar ModelCar objProperties
- append modelDB obj
- )
- self.modelDatabase := modelDB
-
- enterMainMenu self
-
- -- Start Music
- self.music := self.media["music"]
- playMusic self
- )
-
- method playMusic self {class AutoFinderTitle} ->
- (
- if (self.music == undefined) do
- return
-
- playPrepare self.music 1
- play self.music
- )
-
- method endMusic self {class AutoFinderTitle} ->
- (
- local seconds := 4
- local c := new Clock scale:60
- local duration := seconds * 60
- local decibels := -20
-
- if (self.music == undefined) do
- return
-
- -- Schedule a periodic callback to change the volume by the delta.
- addPeriodicCallback c (dap delta -> dap.volume := dap.volume + delta) \
- self.music #((decibels - self.music.volume) / duration) 1
-
- -- Schedule a time callback to stop the clock.
- addTimeCallBack c (clk autofind dap ->
- clk.rate := 0
- stop dap
- playUnprepare dap
- makePurgeable dap
- autofind.music := undefined
- ) c #(self, self.music) duration true
- c.rate := 1
- )
-
- -- Method executeQuery searches ads database for cars that match selections
- -- made by user
- method executeQuery self {class AutoFinderTitle} query ->
- (
- -- Get selected car addObjects that match user criteria
- local carPool := self.carDatabase
- local matchedCars := chooseAll carPool (ad dummy -> \
- (isAKindOf ad AdDataObject) and \
- (isMember query[@classification] ad.classification)) undefined
- carPool := matchedCars
-
- local matchedCars := chooseAll carPool (ad dummy -> \
- (isAKindOf ad AdDataObject) and \
- (isMember query[@year] ad.year)) undefined
- carPool := matchedCars
-
- local matchedCars := chooseAll carPool (ad dummy -> \
- (isAKindOf ad AdDataObject) and \
- (isMember query[@price] ad.price)) undefined
-
- self.carsChosen := matchedCars
-
- -- Get selected modelCars that match user criteria
- local modelList := for c in self.carsChosen collect c.model
- local function modelCarMatch car dummy -> (isAKindOf car ModelCar) and \
- (isMember modelList car.name)
- self.modelsChosen := chooseAll self.modelDatabase modelCarMatch undefined
- )
-
- method enterMainMenu self {class AutoFinderTitle} ->
- (
- -- Set mouse to busy state
- local mouse := self.mouse
- mouse.pointerType := @Wait
-
- -- Load MainMenu
- local mainMenu := new AutofinderMenu boundary:(new rect x2:640 y2:480) \
- media:self.media
-
- -- Change to mainMenu scene
- changeScene self mainMenu
-
- -- Add next scene buttons
- local buttonList := #()
-
- local button := self.grapherButton
- button.x := 528; button.y := 31
- prepend self.stage button
- append buttonList button
-
- button := self.mapButton
- button.x := 528; button.y := 203
- prepend self.stage button
- append buttonList button
-
- button := self.classifiedsButton
- button.x := 525; button.y := 365
- prepend self.stage button
- append buttonList button
-
- -- create exit button
- local exitButton := new navigationButton name:"Exit" \
- releasedBitmap:self.media["Exit Hilite"].bbox \
- pressedBitmap:self.media["Exit Hilite"]
- exitButton.x := 39; exitButton.y := 409
- exitButton.authordata := self
- exitButton.activateAction := (adata pb -> quit() )
- self.exitButton := exitButton
- prepend self.stage exitButton
- append buttonList exitButton
-
- self.buttons := buttonList
- addMany self.actuator self.buttons
-
- mouse.pointerType := @Arrow
- )
-
- method enterGrapher self {class AutoFinderTitle} ->
- (
- -- Set mouse to busy state
- self.mouse.pointerType := @Wait
-
- -- Init the grapher
- local theGrapher := new AutoGrapher media:self.media
-
- -- Change to grapher scene
- changeScene self theGrapher
-
- -- Add next scene buttons
- self.mainMenuButton.x := 83
- self.mainMenuButton.y := 15
- prepend self.stage self.mainMenuButton
- append self.buttons self.mainMenuButton
-
- self.classifiedsButton.x := 155
- self.classifiedsButton.y := 12
- prepend self.stage self.classifiedsButton
- append self.buttons self.classifiedsButton
-
- self.mapButton.x := 236
- self.mapButton.y := 15
- prepend self.stage self.mapButton
- append self.buttons self.mapButton
- addMany self.actuator self.buttons
-
- addObjectsToGraph theGrapher self.modelsChosen
- graphObjects theGrapher self.modelsChosen
-
- self.mouse.pointerType := @Arrow
- )
-
- method enterAds self {class AutoFinderTitle} ->
- (
- self.mouse.pointerType := @Wait
-
- -- instantiate the classified ads document
- local lib := open LibraryContainer dir:self.dir path:"cars.sxl" mode:@readOnly
- load lib["adObject"]
-
- -- Create the document itself.
- local classifieds := new ClassifiedAds media:self.media \
- adsPerPage:3 \
- target:(new array)\
- boundary:(new rect x2:640 y2:480)
-
- changeScene self classifieds
-
- postads classifieds self.carsChosen
-
- -- Add next scene buttons
- self.mainMenuButton.x := 83
- self.mainMenuButton.y := 15
- prepend self.stage self.mainMenuButton
- append self.buttons self.mainMenuButton
-
- self.mapButton.x := 157
- self.mapButton.y := 14
- prepend self.stage self.mapButton
- append self.buttons self.mapButton
-
- self.grapherButton.x := 235
- self.grapherButton.y := 14
- prepend self.stage self.grapherButton
- append self.buttons self.grapherButton
- addMany self.actuator self.buttons
-
- self.mouse.pointerType := @Arrow
- self
- )
-
- -- Creates the Mapper scene and adds it to the stage.
- method enterMap self {class AutoFinderTitle} ->
- (
- -- Set mouse to busy state
- self.mouse.pointerType := @Wait
-
- -- Create the Mapper and add it to the stage.
- local map := new Mapper boundary:(new Rect x2:640 y2:480) \
- manager:self media:self.media
-
- changeScene self map
-
- addManyObjects map self.carsChosen
-
- -- Add next scene buttons
- local buttonList := #()
- local button := self.mainMenuButton
- button.x := 83; button.y := 15
- prepend self.stage button
- append buttonList button
-
- button := self.classifiedsButton
- button.x := 155; button.y := 12
- prepend self.stage button
- append buttonList button
-
- button := self.grapherButton
- button.x := 235; button.y := 14
- prepend self.stage button
- append buttonList button
-
- self.buttons := buttonList
- addMany self.actuator self.buttons
-
- self.mouse.pointerType := @Arrow
- )
-
- -- Method to check if an accessory is appropriate for this title. It must
- -- answer the following questions:
- --
- -- @question1 --Do you want to add yourself to me?
- -- @question2 --Do you inherit from TwoDPresenter, i.e. can you be appended
- -- to a window?
- method isAppropriateAccessory self {class AutoFinderTitle} acc ->
- (
- local answer := false
-
- if (isDefined accessoryAnswersGetter) and \
- (canObjectDo acc accessoryAnswersGetter) do
- (
- if ((getOne acc.accessoryAnswers @question1) = @yes) then
- (
- answer := true
- )
- else
- (
- if ((getOne acc.accessoryAnswers @question2) = @yes) do
- (
- answer := true
- )
- )
- )
- return answer
- )
-
- -- Overridden example method to get and add a generic accessory to a scene.
- --
- -- (Note: This will not work for the tape measure accessory because the tape
- -- measure requires two items to be appended to the current scene, the
- -- tape measure and its 'display' instance variable. Also, the tape
- -- measure requires that the method updateScale be called on it after
- -- it has been appended to the current scene. But that is too specific
- -- for this general addAccessory method. That is why the tape measure
- -- takes care of adding itself to a title. See the tape measure
- -- accessory container's startupAction IV defined in maketape.sx.
- method addAccessory self {class AutoFinderTitle} acc ->
- (
- self.mouse.pointerType := @Wait
-
- if ((getOne acc.accessoryAnswers @question1) != @yes) do
- (
- local thisAcc := (getAccessories acc)[1] --assume there is only one item
-
- -- You could put additional code in here to check the various
- -- answers in the accessoryAnswers IV of the AccessoryContainer,
- -- and decide what to do with the accessory based on those answers.
- --
- -- I am going to get check to see if the accessory can do an addToTitle.
- -- If it can't, then I'll check to see if it's a presenter, and add it
- -- it myself.
-
- if (canObjectDo thisAcc addToTitle) then
- (
- addToTitle thisAcc pres:self.currentScene
- )
- else
- (
- if ((getOne acc.accessoryAnswers @question2) = @yes) do
- (
- prepend self.currentScene thisAcc
- )
- )
- )
-
- self.mouse.pointerType := @Arrow
-
- nextMethod self acc
- )
-
- -- Method importTool opens a file dialog to import the tape measure.
- method importTool self {class AutoFinderTitle} ->
- (
- -- Open a file panel to import the tape measure.
- local op := new OpenPanel
- openFilePanel op
- if (not op.validReply) do return
-
- -- Open the storage container and load the tape meaure accessory.
- self.mouse.pointerType := @Wait
- local fileName := op.filename[size op.fileName]
- deleteLast op.fileName
- local drep := spawn theRootDir op.fileName
- local c := open AccessoryContainer dir:drep path:fileName
- addAccessory self c
- )
-
- -- Method initKeyboardWatch sets up an event receiver for keyboard events,
- -- restricting the key code to the character "i". When an "i" is keyed and the
- -- @command key modifier is active, the importTool method is invoked on the stage manager.
- method initKeyboardWatch self {class AutoFinderTitle} ->
- (
- local kd
- kd := new KeyboardDownEvent
- kd.device := new KeyboardDevice
- kd.eventReceiver := (arg interest ev ->
- if (isMember ev.keyModifiers @control) do importTool self)
- kd.maxKeyCode := 73
- kd.minKeyCode := 73
- addEventInterest kd
- )
-
- "Compiled autofind.sx"
- --->>>
-